home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD ROM Paradise Collection 4
/
CD ROM Paradise Collection 4 1995 Nov.iso
/
edit
/
yame.zip
/
YSAMPLES.PRG
< prev
Wrap
Text File
|
1994-03-09
|
20KB
|
570 lines
* YSamples.prg
*
* Sample application for YAME -- Yet Another Memo Editor
*
* by Kenneth Chan
* Please refer to YAME.DOC for contacts
*
* 08/21/93
*
use YSAMPLES
define popup uYAME from 7,26
define bar 1 of uYAME prompt " Single memo with .FMT " message " WP option in CONFIG.DB "
define bar 2 of uYAME prompt " Multiple memo with .FMT " message " WP option in CONFIG.DB and YAMEPARM "
define bar 3 of uYAME prompt " .BIN invocation " message " LOAD and CALL "
define bar 4 of uYAME prompt "──────────────────────────" skip
define bar 5 of uYAME prompt " Last two rows problem " message " Demonstrate problem with losing lines 23 and 24 "
define bar 6 of uYAME prompt " Last two rows solution " message " Workaround for problem with losing lines 23 and 24 "
define bar 7 of uYAME prompt "──────────────────────────" skip
define bar 8 of uYAME prompt " Go to dot prompt " message " RETURN "
define bar 9 of uYAME prompt " Go to DOS " message " QUIT "
on selection popup uYAME deactivate popup
do while .t.
clear
@ 4,34 say "YAME Samples"
@ 3,26 to 5,53 double
activate popup uYAME
do case
case "Single" $ prompt()
do Fmt1
case "Multiple" $ prompt()
do Fmt2
case "BIN" $ prompt()
do BinInvoc
case "problem" $ prompt()
do RowsProb
case "solution" $ prompt()
do RowsSol
case "DOS" $ prompt()
quit
otherwise
exit
endcase
enddo
release popup uYAME
use in YSAMPLES
RETURN
PROCEDURE Fmt1
set format to YSAMPLE1
*-- Goto record with memo formatted for this form. In your applications,
*-- all your memos will be formatted the same, but in this demo file, there
*-- are different memos for the different implementations/margins.
goto 1 && soft returns at 57 margin
edit next 1 nomenu
set format to
RETURN
PROCEDURE Fmt2
set format to YSAMPLE2
load YAMEPARM
*-- Goto record with memo formatted for this form.
goto 2 && soft returns at 37 margin
edit next 1 nomenu
*-- Uninstall YAMPARM by CALLing it with no parameters
call YAMEPARM
release module YAMEPARM
set format to
RETURN
PROCEDURE BinInvoc
*-- Load YAME (note .COM extension)
load Y.COM
*-- Load edit buffer
load YAMEBUFF
*-- Init buffer with maximum allowed memo size. 65024 is maximum maximum.
call YAMEBUFF with 65024
*-- Goto record with memo formatted for this form.
goto 3 && YAME native; no soft returns
clear
@ 1, 1 say ".BIN invocation: using the provided MemoKey() function, you can simulate the"
@ 2, 1 say "standard key action for a memo field. Here, there is one open window and one"
@ 3, 1 say "memo marker. The YAMEBUFF.BIN file must be loaded and initialized for the"
@ 4, 1 say ".BIN invocation to work."
@ 7, 0 to 7,79
@ 8,27 say "Topic"
@ 8,33 get TOPIC
@ 10,14 say "Argument FOR"
*-- Putting the memo marker one row down and one column to the right
* ╔══════════════════════╗
* ║memo ║
* ║ ║
* ║ ║
* ╚══════════════════════╝
*-- of the window puts cursor at top left of the inside of the memo window
@ 12, 1 get ARG_PRO ;
when MemoKey( 11, 0, 19, 39, "/i19,1" )
*-- Display the contents of the open window
do DispMemo with "ARG_PRO", 11, 0, 19, 39
*-- For this field use a memo marker
@ 10,52 say "Argument AGAINST"
*-- by putting the memo field outside the window
@ 10,69 get ARG_CON ;
when MemoKey( 11, 40, 19, 79, "/i19,41" )
@ 22,28 say "by"
@ 22,31 get AUTHOR
read
*-- Uninstall YAMEBUFF with CALLing with no parameters
call YAMEBUFF
release module YAMEBUFF
*-- No separate uninstall for Y.COM; just RELEASE
release module Y
RETURN
PROCEDURE RowsProb
clear
@ 1, 0 to 23,79 176
*-- Goto record with memo formatted for this demo
goto 1
*-- Copy the memo field to a temp file to workaround abort READ anomaly
copy to ONEMEMO field ARG_CON next 1
use ONEMEMO in select()
@ 4, 6 get TOPIC ;
message " Cursor down to the memo field "
@ 6, 6 get ONEMEMO->ARG_CON ;
message " Press CTRL-HOME then press ESC. Watch this line and the line above. "
@ 8, 6 get AUTHOR ;
message " Cursor up to the memo field "
read
*-- If changes were made, copy memo back from temp file
if readkey() >= 256
replace ARG_CON with ONEMEMO->ARG_CON
endif
*-- Erase temp file(s)
use in ONEMEMO
erase ONEMEMO.DBF
erase ONEMEMO.DBT
RETURN
PROCEDURE RowsSol
clear
@ 1, 0 to 23,79 176
*-- Goto record with memo formatted for this demo
goto 1
*-- Copy the memo field to a temp file to workaround abort READ anomaly
copy to ONEMEMO field ARG_CON next 1
use ONEMEMO in select()
*-- State variable
public n_MemoScrn
* 0 == no checking
* 1 == initial entry into memo field
* 2 == grab next key
* 3 == screen saved
*-- Set state for initial entry into memo field
n_MemoScrn = 1
@ 4, 6 get TOPIC ;
message " Cursor down to the memo field "
@ 6, 6 get ONEMEMO->ARG_CON ;
when ForcValid() ;
valid required MemoScrn() ;
error "" ;
message " Press CTRL-HOME then press ESC. Watch this line and the line above. "
@ 8, 6 get AUTHOR ;
message " Cursor up to the memo field "
read
*-- If changes were made, copy memo back from temp file
if readkey() >= 256
replace ARG_CON with ONEMEMO->ARG_CON
endif
*-- Erase temp file(s)
use in ONEMEMO
erase ONEMEMO.DBF
erase ONEMEMO.DBT
*-- Release state variable
release n_MemoScrn
RETURN
FUNCTION ForcValid
*----------------------------------------------------------------------------
*-- Programmer..: Kenneth Chan [Zak] CIS:72662,1305
*-- Date........: 01/27/1993
*-- Notes.......: Workaround for losing last two lines on screen when
* using external memo editor.
*
* Forces a VALID check, activating MemoScrn()
*
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: 01/27/1993 1.0
*-- Calls.......: Works in tandem with MemoScrn()
* The memvar n_MemoScrn must be defined, and should be
* set to 1 before the READ
* *-- State variable
* public n_MemoScrn
* * 0 == no checking
* * 1 == initial entry into memo field
* * 2 == grab next key
* * 3 == screen saved
* *-- Set state for initial entry into memo field
* n_MemoScrn = 1
*-- Called by...: WHEN clause of GET
*-- Usage.......: when ForcValid() valid required MemoScrn()
*-- Example.....: @ 6,11 get NOTES ;
* when ForcValid() ;
* valid required MemoScrn() ;
* error ""
*-- Returns.....: .T.
*-- Parameters..: <none>
*----------------------------------------------------------------------------
if n_MemoScrn = 1
*-- Move to next stage
n_MemoScrn = 2
*-- Trigger VALID check
keyboard "{CTRL-M}"
*-- Silence bell
set bell to 19,1
endif
if n_MemoScrn = 0
*-- Set state var for next memo field
n_MemoScrn = 1
*-- Restore bell to default tone
set bell to 512,2
endif
RETURN .t.
FUNCTION MemoScrn
*----------------------------------------------------------------------------
*-- Programmer..: Kenneth Chan [Zak] CIS:72662,1305
*-- Date........: 01/27/1993
*-- Notes.......: Workaround for losing last two lines on screen when
* using external memo editor.
*
* Works better when the ERROR message is set to
* nothing ("").
*
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: 01/27/1993 1.0
*-- Calls.......: Works in tandem with ForcValid()
* The memvar n_MemoScrn must be defined
* *-- State variable
* public n_MemoScrn
* * 0 == no checking
* * 1 == initial entry into memo field
* * 2 == grab next key
* * 3 == screen saved
*-- Called by...: VALID REQUIRED clause of GET
*-- Usage.......: when ForcValid() valid required MemoScrn()
*-- Example.....: @ 6,11 get NOTES ;
* when ForcValid() ;
* valid required MemoScrn() ;
* error ""
*-- Returns.....: .T. eventually
*-- Parameters..: <none>
*----------------------------------------------------------------------------
private lRet, nKey
if n_MemoScrn > 1
if n_MemoScrn = 3
*-- Restore lines 23 and 24
restore screen from sMemoScrn
release screen sMemoScrn
endif
*-- Wait for keypress
nKey = inkey( 0 )
*-- Return VALID false to force next action to occur in
*-- current field
lRet = .f.
*-- Clear VALID error message
keyboard " "
*-- Ctrl-Home; edit memo
if nKey = 29
save screen to sMemoScrn
n_MemoScrn = 3
*-- Open memo and force recheck
keyboard "{CTRL-HOME}{CTRL-M}"
else
*-- Don't stop the next key
n_MemoScrn = 0
*-- Type the key that was trapped
keyboard "{" + ltrim( str( nKey )) + "}"
endif
else
*-- Pass key through
lRet = .t.
*-- Must init PRIVATE memvar
nKey = 0
endif
RETURN lRet
PROCEDURE DispMemo
*----------------------------------------------------------------------------
*-- Programmer..: Kenneth Chan [Zak] CIS:72662,1305
*-- Date........: 07/14/1993
*-- Notes.......: Displays a memo field in a window
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: 07/14/1993 1.0
*-- Calls.......: <none>
*-- Called by...: <any>
*-- Usage.......: do DispMemo with <cMemoFld>, <nTop>, <nLft>, <nBtm>, <nRht>
*-- Example.....: do DispMemo with "NOTES", 5, 10, 18, 69
*-- Returns.....: <na>
*-- Parameters..: cMemoFld = name of memo field
* nTop = top row of window
* nLft = left column of window
* nBtm = bottom row of window
* nRht = right column of window
*----------------------------------------------------------------------------
parameter cMemoFld, nTop, nLft, nBtm, nRht
private nOldWidth, n1
nOldWidth = set( "MEMOWIDTH" )
*-- Set MEMOWIDTH for window
set memowidth to nRht - nLft - 2
*-- Draw border
@ nTop, nLft to nBtm, nRht
@ nTop + 1, nLft + 1 clear to nBtm - 1, nRht - 1
n1 = 1
*-- Display each line
do while n1 < nBtm - nTop
@ nTop + n1, nLft + 1 say mline( &cMemoFld., n1 )
n1 = n1 + 1
enddo
set memowidth to nOldWidth
RETURN
FUNCTION MemoKey
*---------------------------------------------------------------------
*-- Programmer..: Kenneth Chan [Zak] CIS:72662,1305
*-- Date........: 03/09/1994
*-- Notes.......: Emulates standard behavior when cursor is on memo
* marker. If Ctrl-Home or F9 is pressed, YAME is
* CALLed. Defaults to double border, and margins to
* fit in window.
*
* If memo field is inside window coordinates, memo is
* treated like an OPEN WINDOW.
*
* If memo window is inside a DEFINEd and ACTIVATEd
* WINDOW, specify the main (first set) of coordinates
* relative to that window, as you would the @ GET.
* Then specify the top left of the WINDOW, and if the
* border is NONE, indicate that as well. For example:
*
* define window wEdit from 8,10 to 16,70
* activate window wEdit
* *-- Put the field marker inside the memo window
* @ 2, 1 get MEMO_FIELD ;
* when MemoKey( 1, 0, 5, 39, "", "", 8, 10 )
* *-- Display the contents of the open window
* do DispMemo with "MEMO_FIELD", 1, 0, 5, 39
*
* Since YAME is CALLEed, YAMEBUFF must be LOADed and
* initialized (see YAME.DOC)
*
*-- Written for.: dBASE IV, 1.5
*-- Rev. History: 07/14/1993 1.0
* 03/09/1994 1.1 Support for DEFINEd WINDOWs and
* MESSAGEs
*-- Calls.......: Y.COM, (YAMEBUFF), DispMemo
*-- Called by...: WHEN clause of GET
*-- Usage.......: when MemoKey( <nTop>, <nLft>, <nBtm>, <nRht>, ;
* [ <cExtraParm> [, <cMessage> ;
* [, <nWinTop>, <nWinLft> [, <lNoBorder> ]]]] )
*-- Example.....: @ 6,11 get NOTES when MemoKey( 5, 10, 18, 69 )
*-- Returns.....: .T.
*-- Parameters..: nTop = top row of window
* nLft = left column of window
* nBtm = bottom row of window
* nRht = right column of window
* OPTIONAL:
* cExtraParm = extra parameters to pass to YAME
* cMessage = message to display on MESSAGE line
* nWinTop = top row of DEFINEd WINDOW
* nWinLft = left column of DEFINEd WINDOW
* lNoBorder = DEFINEd WINDOW border NONE?
*---------------------------------------------------------------------
parameters nTop, nLft, nBtm, nRht, cExtraParm, cMessage, ;
nWinTop, nWinLft, lNoBorder
*-- Make sure extra parameter is defined
if pcount() < 5
cExtraParm = ""
endif
*-- Make sure message text is defined
if pcount() < 6
cMessage = ""
endif
*-- If no DEFINEd WINDOW, top and left are 0, and no border
if pcount() < 8
nWinTop = 0
nWinLft = 0
lNoBorder = .t.
endif
private nRow, nCol, lLoop, cYAMEPARM, cMemoFld, cColorFld
*-- Construct YAME parameter string
cYAMEParm = "/m" + ltrim( str( nRht - nLft - 2 )) + " /@" + ;
ltrim( str( nTop + nWinTop + iif( lNoBorder, 0, 1 ))) + "," + ;
ltrim( str( nLft + nWinLft + iif( lNoBorder, 0, 1 ))) + "," + ;
ltrim( str( nBtm + nWinTop + iif( lNoBorder, 0, 1 ))) + "," + ;
ltrim( str( nRht + nWinLft + iif( lNoBorder, 0, 1 ))) + ;
" /bd " + cExtraParm + " MEMO_TMP.$DB"
cMemoFld = varread()
nRow = row()
nCol = col()
*-- Get the COLOR OF FIELDS
cColorFld = substr( set( "ATTRIBUTES" ), ;
rat( ",", set( "ATTRIBUTES" )) + 1 )
if file( "MEMO_TMP.$DB" )
erase MEMO_TMP.$DB
endif
copy memo &cMemoFld. to MEMO_TMP.$DB
*-- Display message if there is one
if "" # cMessage
*-- MESSAGE memvars
private nBtmRow, cMsgColor, cWindow
*-- If memo window is in a WINDOW, we will need to ACTIVATE SCREEN
*-- for the messages
cWindow = window()
*-- and do it now to properly determine the MESSAGES color
if .not. isblank( cWindow )
activate screen
endif
*-- Figure out bottom row from DISPLAY SETting
nBtmRow = val( right( set( "DISPLAY" ), 2 ))
*-- Bottom row of MONO and COLOR is row 24
nBtmRow = iif( m->nBtmRow = 0, 24, m->nBtmRow - 1 )
*-- MESSAGES color is first one after ampersands
cMsgColor = set( "ATTRIBUTES" )
cMsgColor = substr( m->cMsgColor, at( "&", m->cMsgColor ) + 3 )
cMsgColor = left( m->cMsgColor, at( ",", m->cMsgColor ) - 1 )
*-- and it's always bright
if .not. "+" $ m->cMsgColor
cMsgColor = stuff( m->cMsgColor, at( "/", m->cMsgColor ), 0, "+" )
endif
*-- Clear the message line
@ m->nBtmRow, 0 clear to m->nBtmRow,79
*-- Display message centered
@ m->nBtmRow, 40 - ceiling( len( cMessage ) / 2 ) ;
say cMessage color &cMsgColor.
if .not. isblank( cWindow )
activate window &cWindow.
endif
*-- Move cursor back to memo marker
@ nRow, nCol say ""
endif
lLoop = .t.
do while lLoop
nKey = inkey( 0 )
do case
case nKey = 29 .or. nKey = -8 && Ctrl-Home or F9
save screen to sMemoKey
*-- Invoke YAME; exit code returned in parameter string
call Y with cYAMEParm
restore screen from sMemoKey
release screen sMemoKey
*-- Check exit code to see if file was saved
if cYAMEParm = "0"
*-- Update memo field
append memo &cMemoFld. from MEMO_TMP.$DB overwrite
endif
*-- If memo marker is outside the window
if nRow < nTop .or. nRow > nBtm .or. nCol + 3 < nLft ;
.or. nCol > nRht
*-- Update the memo marker
@ nRow, nCol say iif( len( &cMemoFld. ) = 0, "memo", "MEMO" );
color &cColorFld.
else
*-- Redisplay memo
do DispMemo with cMemoFld, nTop, nLft, nBtm, nRht
endif
*-- Overwrite exit code with original slash
cYAMEParm = stuff( cYAMEParm, 1, 1, "/" )
*-- Do not KEYBOARD Ctrl-Home
nKey = 0
case "," + ltrim( str( nKey )) + "," $ ;
",1,3,4,5,6,9,13,17,18,19,23,24,27,-400,"
*-- These keys will move the cursor, let them pass
case nKey > 0 .and. nKey < 256
*-- Ignore all other non-function keys
nKey = 0
otherwise
*-- KEYBOARD function key to allow for ON KEY traps
keyboard "{" + ltrim( str( nKey )) + "}"
*-- Clear keyboard buffer in case no one wanted function key
nKey = inkey()
*-- but don't leave
nKey = 0
endcase
if nKey # 0
*-- Type key
keyboard "{" + ltrim( str( nKey )) + "}" clear
*-- Quit loop
lLoop = .f.
endif
*-- Move cursor back after possible memo redraw
@ nRow, nCol say ""
enddo
*-- Clear the message if one was displayed
if "" # cMessage
if .not. isblank( cWindow )
activate screen
endif
@ m->nBtmRow, 0 clear to m->nBtmRow,79
if .not. isblank( cWindow )
activate window &cWindow.
endif
*-- Move cursor back to memo marker
@ nRow, nCol say ""
endif
if file( "MEMO_TMP.$DB" )
erase MEMO_TMP.$DB
endif
*-- Return .T. to read stuffed keystroke
RETURN .t.
*-- If you don't have dBASE IV v2.0, here's a RAT() UDF
FUNCTION RAt
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 03/01/1992
*-- Notes.......: Reverse "at", returns position a character string is last
*-- AT in a larger string.
*-- Written for.: dBASE IV
*-- Rev. History: 03/01/1992 -- Original Release
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Rat("<cFindStr>","<cBigStr>")
*-- Example.....: ? Rat("Test","This is a Test string, with Test data")
*-- Returns.....: Numeric value
*-- Parameters..: cFindStr = string to find in cBigStr
*-- cBigStr = string to look in
*-------------------------------------------------------------------------------
parameters cFindstr, cBigstr
private nPos,nLen
nLen = len( cFindstr )
nPos = len( cBigstr ) - nLen + 1
do while nPos > 0
if substr( cBigstr, nPos, nLen ) = cFindstr
exit
else
nPos = nPos - 1
endif
enddo
RETURN max( nPos, 0 )
*-- EoF: RAt()